SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00014 ANSI CONTROL & OUTPUT 1 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Character Driver IMPORT 66 Unit Ansi; (* Ho ho ho -Santa Clause) *)ππInterfaceππUses Crt;ππProcedure Display_ANSI(ch:Char);π{ Displays ch following ANSI Graphics protocol }ππ{---------------------------------------------------------------------- -----}π{ Useful information For porting this thing over to other computers:ππ Change background Text color Change foreground Text colorπ TextBackground(0) = black TextColor(0) = blackπ TextBackground(1) = blue TextColor(1) = blueπ TextBackground(2) = green TextColor(2) = greenπ TextBackground(3) = cyan TextColor(3) = cyanπ TextBackground(4) = red TextColor(4) = redπ TextBackground(5) = Magenta TextColor(5) = magentaπ TextBackground(6) = brown TextColor(6) = brownπ TextBackground(7) = light grey TextColor(7) = whiteπ TextColor(8) = greyπ Delete(s,i,c); TextColor(9) = bright blueπ Delete c Characters from TextColor(10)= bright greenπ String s starting at i TextColor(11)= bright cyanπ Val(s,v,c); TextColor(12)= bright redπ convert String s to numeric TextColor(13)= bright magentaπ value v. code=0 if ok. TextColor(14)= bright yellowπ Length(s) TextColor(15)= bright whiteπ length of String sπ}ππImplementationππVarπ ANSI_St :String ; {stores ANSI escape sequence if receiving ANSI}π ANSI_SCPL :Integer; {stores the saved cursor position line}π ANSI_SCPC :Integer; { " " " " " column}π ANSI_FG :Integer; {stores current foreground}π ANSI_BG :Integer; {stores current background}π ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ; {stores current attribute options}ππp,x,y : Integer;ππProcedure Display_ANSI(ch:Char);π{ Displays ch following ANSI Graphics protocal }ππ Procedure TABULATE;π Var x:Integer;π beginπ x:=WhereX;π if x<80 thenπ Repeatπ Inc(x);π Until (x MOD 8)=0;π if x=80 then x:=1;π GotoXY(x,WhereY);π if x=1 then WriteLN;π end;ππ Procedure BACKSPACE;π Var x:Integer;π beginπ if WhereX>1 thenπ Write(^H,' ',^H)π elseπ if WhereY>1 then beginπ GotoXY(80,WhereY-1);π Write(' ');π GotoXY(80,WhereY-1);π end;π end;ππ Procedure TTY(ch:Char);π Var x:Integer;π beginπ if ANSI_C then beginπ if ANSI_I then ANSI_FG:=ANSI_FG or 8;π if ANSI_B then ANSI_FG:=ANSI_FG or 16;π if ANSI_R then beginπ x:=ANSI_FG;π ANSI_FG:=ANSI_BG;π ANSI_BG:=x;π end;π ANSI_C:=False;π end;π TextColor(ANSI_FG);π TextBackground(ANSI_BG);π Case Ch ofπ ^G: beginπ Sound(2000);π Delay(75);π NoSound;π end;π ^H: Backspace;π ^I: Tabulate;π ^J: beginπ TextBackground(0);π Write(^J);π end;π ^K: GotoXY(1,1);π ^L: beginπ TextBackground(0);π ClrScr;π end;π ^M: beginπ TextBackground(0);π Write(^M);π end;π else Write(Ch);π end;π end;ππ Procedure ANSIWrite(S:String);π Var x:Integer;π beginπ For x:=1 to Length(S) doπ TTY(S[x]);π end;ππ Function Param:Integer; {returns -1 if no more parameters}π Var S:String;π x,XX:Integer;π B:Boolean;π beginπ B:=False;π For x:=3 to Length(ANSI_St) DOπ if ANSI_St[x] in ['0'..'9'] then B:=True;π if not B thenπ Param:=-1π else beginπ S:='';π x:=3;π if ANSI_St[3]=';' then beginπ Param:=0;π Delete(ANSI_St,3,1);π Exit;π end;π Repeatπ S:=S+ANSI_St[x];π x:=x+1;π Until (NOT (ANSI_St[x] in ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));π if Length(S)>2 then beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π Param:=-1;π Exit;π end;π Delete(ANSI_St,3,Length(S));π if ANSI_St[3]=';' then Delete(ANSI_St,3,1);π Val(S,x,XX);π Param:=x;π end;π end;ππbeginπ if (Ch<>#27) and (ANSI_St='') then beginπ TTY(Ch);π Exit;π end;π if Ch=#27 then beginπ if ANSI_St<>'' then beginπ ANSIWrite(ANSI_St+#27);π ANSI_St:='';π end else ANSI_St:=#27;π Exit;π end;π if ANSI_St=#27 then beginπ if Ch='[' thenπ ANSI_St:=#27+'['π else beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π end;π Exit;π end;π if (Ch='[') and (ANSI_St<>'') then beginπ ANSIWrite(ANSI_St+'[');π ANSI_St:='';π Exit;π end;π if not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) then beginπ ANSIWrite(ANSI_St+Ch);π ANSI_St:='';π Exit;π end;π if Ch in ['A'..'D','f','H','J','K','m','s','u'] then beginπ Case Ch ofπ 'A': beginπ p:=Param;π if p=-1 then p:=1;π if WhereY-p<1 thenπ GotoXY(WhereX,1)π else GotoXY(WhereX,WhereY-p);π end;π 'B': beginπ p:=Param;π if p=-1 then p:=1;π if WhereY+p>25 thenπ GotoXY(WhereX,25)π else GotoXY(WhereX,WhereY+p);π end;π 'C': beginπ p:=Param;π if p=-1 then p:=1;π if WhereX+p>80 thenπ GotoXY(80,WhereY)π else GotoXY(WhereX+p,WhereY);π end;π 'D': beginπ p:=Param;π if p=-1 then p:=1;π if WhereX-p<1 thenπ GotoXY(1,WhereY)π else GotoXY(WhereX-p,WhereY);π end;π'H','f': beginπ Y:=Param;π x:=Param;π if Y<1 then Y:=1;π if x<1 then x:=1;π if (x>80) or (x<1) or (Y>25) or (Y<1) then beginπ ANSI_St:='';π Exit;π end;π GotoXY(x,Y);π end;π 'J': beginπ p:=Param;π if p=2 then beginπ TextBackground(0);π ClrScr;π end;π if p=0 then beginπ x:=WhereX;π Y:=WhereY;π Window(1,y,80,25);π TextBackground(0);π ClrScr;π Window(1,1,80,25);π GotoXY(x,Y);π end;π if p=1 then beginπ x:=WhereX;π Y:=WhereY;π Window(1,1,80,WhereY);π TextBackground(0);π ClrScr;π Window(1,1,80,25);π GotoXY(x,Y);π end;π end;π 'K': beginπ TextBackground(0);π ClrEol;π end;π 'm': beginπ if ANSI_St=#27+'[' then beginπ ANSI_FG:=7;π ANSI_BG:=0;π ANSI_I:=False;π ANSI_B:=False;π ANSI_R:=False;π end;π Repeatπ p:=Param;π Case p ofπ -1:;π 0:beginπ ANSI_FG:=7;π ANSI_BG:=0;π ANSI_I:=False;π ANSI_R:=False;π ANSI_B:=False;π end;π 1:ANSI_I:=True;π 5:ANSI_B:=True;π 7:ANSI_R:=True;π 30:ANSI_FG:=0;π 31:ANSI_FG:=4;π 32:ANSI_FG:=2;π 33:ANSI_FG:=6;π 34:ANSI_FG:=1;π 35:ANSI_FG:=5;π 36:ANSI_FG:=3;π 37:ANSI_FG:=7;π 40:ANSI_BG:=0;π 41:ANSI_BG:=4;π 42:ANSI_BG:=2;π 43:ANSI_BG:=6;π 44:ANSI_BG:=1;π 45:ANSI_BG:=5;π 46:ANSI_BG:=3;π 47:ANSI_BG:=7;π end;π if ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) thenπANSI_C:=True;π Until p=-1;π end;π 's': beginπ ANSI_SCPL:=WhereY;π ANSI_SCPC:=WhereX;π end;π 'u': beginπ if ANSI_SCPL>-1 then GotoXY(ANSI_SCPC,ANSI_SCPL);π ANSI_SCPL:=-1;π ANSI_SCPC:=-1;π end;π end;π ANSI_St:='';π Exit;π end;π if Ch in ['0'..'9',';'] thenπ ANSI_St:=ANSI_St+Ch;π if Length(ANSI_St)>50 then beginπ ANSIWrite(ANSI_St);π ANSI_St:='';π Exit;π end;πend;πππbeginπ ANSI_St:='';π ANSI_SCPL:=-1;π ANSI_SCPC:=-1;π ANSI_FG:=7;π ANSI_BG:=0;π ANSI_C:=False;π ANSI_I:=False;π ANSI_B:=False;π ANSI_R:=False;πEND. 2 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Character Driver #2 IMPORT 61 UNIT Ansi;ππINTERFACEπππUSES Crt, Dos;ππCONSTπ RecANSI : BOOLEAN = FALSE;ππPROCEDURE AnsiWrite (ch : CHAR);πPROCEDURE AnsiWriteLn (S : STRING);ππIMPLEMENTATIONπππVARπ Escape, Saved_X,π Saved_Y : BYTE;π Control_Code : STRING;ππFUNCTION GetNumber (VAR LINE : STRING) : INTEGER;ππ VARπ i, j, k : INTEGER;π temp0, temp1 : STRING;ππ BEGINπ temp0 := LINE;π VAL (temp0, i, j);π IF j = 0 THEN temp0 := ''π ELSEπ BEGINπ temp1 := COPY (temp0, 1, j - 1);π DELETE (temp0, 1, j);π VAL (temp1, i, j);π END;π LINE := temp0;π GetNumber := i;π END;ππ PROCEDURE loseit;π BEGINπ escape := 0;π control_code := '';π RecANSI := FALSE;π END;ππ PROCEDURE Ansi_Cursor_move;ππ VARπ x, y : INTEGER;ππ BEGINπ y := GetNumber (control_code);π IF y = 0 THEN y := 1;π x := GetNumber (control_code);π IF x = 0 THEN x := 1;π IF y > 25 THEN y := 25;π IF x > 80 THEN x := 80;π GOTOXY (x, y);π loseit;π END;ππPROCEDURE Ansi_Cursor_up;ππ VARπ y, new_y, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π y := WHEREY;π IF (y - Offset) < 1 THENπ New_y := 1π ELSEπ New_y := y - offset;π GOTOXY (WHEREX, new_y);π loseit;π END;ππPROCEDURE Ansi_Cursor_Down;ππ VARπ y, new_y, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π y := WHEREY;π IF (y + Offset) > 25 THENπ New_y := 25π ELSEπ New_y := y + offset;π GOTOXY (WHEREX, new_y);π loseit;π END;ππPROCEDURE Ansi_Cursor_Left;ππ VARπ x, new_x, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π x := WHEREX;π IF (x - Offset) < 1 THENπ New_x := 1π ELSEπ New_x := x - offset;π GOTOXY (new_x, WHEREY);π loseit;π END;ππPROCEDURE Ansi_Cursor_Right;ππ VARπ x, new_x, offset : INTEGER;ππ BEGINπ Offset := getnumber (control_code);π IF Offset = 0 THEN offset := 1;π x := WHEREX;π IF (x + Offset) > 80 THENπ New_x := 1π ELSEπ New_x := x + offset;π GOTOXY (New_x, WHEREY);π loseit;π END;ππ PROCEDURE Ansi_Clear_Screen;ππ BEGIN { 0J = cusor to Eos }π CLRSCR; { 1j start to cursor }π loseit; { 2j entie screen/cursor no-move}π END;ππ PROCEDURE Ansi_Clear_EoLine;ππ BEGINπ CLREOL;π loseit;π END;πππ PROCEDURE Reverse_Video;ππ VARπ tempAttr, tblink, tempAttrlo, tempAttrhi : BYTE;ππ BEGINπ LOWVIDEO;π TempAttrlo := (TextAttr AND $7);π tempAttrHi := (textAttr AND $70);π tblink := (textattr AND $80);π tempattrlo := tempattrlo * 16;π tempattrhi := tempattrhi DIV 16;π TextAttr := TempAttrhi + TempAttrLo + TBlink;π END;πππ PROCEDURE Ansi_Set_Colors;ππ VARπ temp0, Color_Code : INTEGER;ππ BEGINπ IF LENGTH (control_code) = 0 THEN control_code := '0';π WHILE (LENGTH (control_code) > 0) DOπ BEGINπ Color_code := getNumber (control_code);π CASE Color_code OFπ 0 : BEGINπ LOWVIDEO;π TEXTCOLOR (LightGray);π TEXTBACKGROUND (Black);π END;π 1 : HIGHVIDEO;π 5 : TextAttr := (TextAttr OR $80);π 7 : Reverse_Video;π 30 : textAttr := (TextAttr AND $F8) + black;π 31 : textattr := (TextAttr AND $f8) + red;π 32 : textattr := (TextAttr AND $f8) + green;π 33 : textattr := (TextAttr AND $f8) + brown;π 34 : textattr := (TextAttr AND $f8) + blue;π 35 : textattr := (TextAttr AND $f8) + magenta;π 36 : textattr := (TextAttr AND $f8) + cyan;π 37 : textattr := (TextAttr AND $f8) + Lightgray;π 40 : TEXTBACKGROUND (black);π 41 : TEXTBACKGROUND (red);π 42 : TEXTBACKGROUND (green);π 43 : TEXTBACKGROUND (yellow);π 44 : TEXTBACKGROUND (blue);π 45 : TEXTBACKGROUND (magenta);π 46 : TEXTBACKGROUND (cyan);π 47 : TEXTBACKGROUND (white);π END;π END;π loseit;π END;πππ PROCEDURE Ansi_Save_Cur_pos;ππ BEGINπ Saved_X := WHEREX;π Saved_Y := WHEREY;π loseit;π END;πππ PROCEDURE Ansi_Restore_cur_pos;ππ BEGINπ GOTOXY (Saved_X, Saved_Y);π loseit;π END;πππ PROCEDURE Ansi_check_code ( ch : CHAR);ππ BEGINπ CASE ch OFπ '0'..'9', ';' : control_code := control_code + ch;π 'H', 'f' : Ansi_Cursor_Move;π 'A' : Ansi_Cursor_up;π 'B' : Ansi_Cursor_Down;π 'C' : Ansi_Cursor_Right;π 'D' : Ansi_Cursor_Left;π 'J' : Ansi_Clear_Screen;π 'K' : Ansi_Clear_EoLine;π 'm' : Ansi_Set_Colors;π 's' : Ansi_Save_Cur_Pos;π 'u' : Ansi_Restore_Cur_pos;π ELSEπ loseit;π END;π END;πππPROCEDURE AnsiWrite (ch : CHAR);ππVARπ temp0 : INTEGER;ππBEGINπ IF escape > 0 THENπ BEGINπ CASE Escape OFπ 1 : BEGINπ IF ch = '[' THENπ BEGINπ escape := 2;π Control_Code := '';π ENDπ ELSEπ escape := 0;π END;π 2 : Ansi_Check_code (ch);π ELSEπ BEGINπ escape := 0;π control_code := '';π RecANSI := FALSE;π END;π END;π ENDπ ELSEπ BEGINπ CASE Ch OFπ #27 : Escape := 1;π #9 : BEGINπ temp0 := WHEREX;π temp0 := temp0 DIV 8;π temp0 := temp0 + 1;π temp0 := temp0 * 8;π GOTOXY (temp0, WHEREY);π END;π #12 : CLRSCR;π ELSEπ BEGINπ IF ( (WHEREX = 80) AND (WHEREY = 25) ) THENπ BEGINπ windmax := (80 + (24 * 256) );π WRITE (ch);π windmax := (79 + (24 * 256) );π ENDπ ELSEπ WRITE (ch);π escape := 0;π END;π END;π END;π RecANSI := (Escape <> 0);π END;ππPROCEDURE AnsiWriteLn (S : STRING);πVAR I : BYTE;πBEGINπFOR I := 1 TO LENGTH (S) DO Ansiwrite (S [i]);πEND;ππEND.π 3 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Display Unit IMPORT 17 {π>How do I make an ansi and put it in my Pascal File? I know there is anπ>option to save as pascal, but it does not look like anything to me!π>Any help is appreciated!ππHere is a Program that will read an ANSI File into a buffer in 2k chunksπthen Write it (to screen) Character by Character. BUT - it will Writeπall ANSI-escape-sequences as StringS.ππ Two reasons For this:ππ 1) I just 'feel happier' if each ANSI escape sequence is written toπ screen as a String instead of as individual Characters. (Its just anπ irrational 'thing' I have)ππ 2) By assembling all the Characters in the escape sequence together,π it make its _easy_ to FILTER OUT all ANSI sequences if you want to justπ output plain black-and-white Text. This is For those people who forπ some strange reason would rather not have ANSI.SYS installed, butπ complain about getting 'garbage' Characters on the screen.ππAll you have to do to filter out the escape sequences is toπun-bracket the 'if AnsiDetected then' part.ππif you want me to post 'Function AnsiDetected: Boolean' just let meπknow.π}ππProgram ansiWrite;ππConst esc = chr(27);π termnChar: SET of Char =π ['f','A'..'D','H','s','u','J','K','l'..'n','h'];ππVar f: File;π buf:Array[1..2048] of Char;π Numread: Word;π num: Integer;π escString: String;π escseq: Boolean;ππbeginπ Assign(f,'FRINGE3.ANS');π Reset(f,1);π escseq := False;π escString:='';π Repeatπ BlockRead(f,buf,Sizeof(Buf),Numread);π { Write Block to Screen }π For NUM := 1 to Numread DOπ beginπ if Buf[Num] = esc then escseq := True;π if escseq=True thenπ beginπ escString:= escString+buf[num];π if Buf[num] in termnChar thenπ beginπ escseq:=False;π {if AnsiDetected then} Write(escString);π escString:=''π endπ endπ else Write(Buf[num])π end; { For }π Until NumRead < SizeOf(Buf);π close(f)πend.π 4 05-28-9313:33ALL SWAG SUPPORT TEAM Direct ANSI Display IMPORT 8 {πDUSTIN NULFππI've run into that familiar problem in trying to view Ansi colored pictures andπusing the Crt Unit at the same time. The Crt Unitπdoesn't translate the Ansi codes and displays them literally. Now,πI've created an Ansi interpreter Procedure that reads each line inπan ansi File and calls the appropriate TextColor/TextBackground Procedures,πaccording to what ansi escape String was found. Thisπis groovy and all, but I just found out something new today With:π}πAssign(Output,'');πReWrite(Output);π{π...and that it translates all the ansi codes For me already! Now,πthe big question is, what are the advantages and disadvantagesπof using this Assign method vs. the Ansi interpreter method? Isπthis Assign method slower/faster, take up more memory, more diskπspace, etc. Any information would be highly appreciated! :)π}π 5 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Output IMPORT 34 {π> Now that I need to make a .ANS bulletin Type File, I was wonderingπ> how to Write from a Pascal Program, ANSI control Characters to aπ> File and produce nice color bulletin screen to be displayed by RA.ππThe following Unit will enable you to Write Ansi sequences to a TextπFile Without having to look them up yourself. It enables you to do thisπusing the (easier) Crt Unit style of commands, and provides the optimumπAnsi sequence to do the job.π}ππUnit AnsiOut;π{1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}π{2. Modified to provide output to a Text File.}ππInterfaceππConst Black = 0; Blue = 1; Green = 2; Cyan = 3;π Red = 4; Magenta = 5; Brown = 6; LightGray = 7;π DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11;π LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15;π Blink = 128;ππVar AnsiFile: Text;ππProcedure TextColor(fore : Byte);πProcedure TextBackGround(back : Byte);πProcedure NormVideo;πProcedure LowVideo;πProcedure HighVideo;πProcedure ClrEol;πProcedure ClrScr;ππImplementationππConst forestr: Array[Black..LightGray] of String[2]π = ('30','34','32','36','31','35','33','37');π backstr: Array[Black..LightGray] of String[2]π = ('40','44','42','46','41','45','43','47');π decisiontree: Array[Boolean, Boolean, Boolean, Boolean] of Integer =π ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));ππVar forecolour, backcolour: Byte; { stores last colours set }π boldstate, blinkstate: Boolean;ππProcedure TextColor(fore : Byte);π Varπ blinknow, boldnow: Boolean;π outstr: String;π beginπ blinknow := (fore and $80) = $80;π boldnow := (fore and $08) = $08;π fore := fore and $07; { mask out intensity and blink attributes }π forecolour := fore;π Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OFπ 0: outstr := Concat(#27,'[',forestr[fore],'m');π 1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');π 2: outstr := Concat(#27,'[1;',forestr[fore],'m');π 3: outstr :=π Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');π 4: outstr := Concat(#27,'[5;',forestr[fore],'m');π 5: outstr :=π Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');π 6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');π end; { Case }π Write(AnsiFile,outstr);π blinkstate := blinknow;π boldstate := boldnow;π end;ππProcedure TextBackGround(back: Byte);π Var outString: String;π beginπ if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }π BackColour := Back;π outString := Concat(#27,'[',backstr[back],'m');π Write(AnsiFile,outString)π end;ππProcedure NormVideo;π beginπ Write(AnsiFile,#27'[0m');π forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπ end;ππProcedure LowVideo;π beginπ if blinkstate then forecolour := forecolour or $80; { retain blinking }π TextColor(forecolour); { stored forecolour never contains bold attr }π end;ππProcedure HighVideo;π beginπ if not boldstate thenπ beginπ boldstate := True;π Write(AnsiFile,#27,'[1m')π end;π end;ππProcedure ClrEol;π beginπ Write(AnsiFile,#27'[K')π end;ππProcedure ClrScr;π beginπ Write(AnsiFile,#27'[2J');π end;ππbeginπ forecolour := LightGray;π backcolour := Black;π boldstate := False;π blinkstate := Falseπend.ππ___------------------------------------------------------------------πProgram Demo;πUses AnsiOut;πbeginπ Assign(AnsiFile,'CON'); { or a File - e.g. 'MYSCREEN.ANS' }π ReWrite(AnsiFile);π ClrScr;π TextColor(Blue); TextBackGround(LightGray);π Writeln(AnsiFile,' Blue Text on LightGray ');π HighVideo; Write(AnsiFile,' Now the Text is LightBlue ');π TextBackground(Red); Writeln(AnsiFile,' on a Red background');π TextColor(Black+Blink); TextBackground(Cyan);π Writeln(AnsiFile,' Blinking Black ');π TextBackGround(Green); ClrEol; { a blank Green line }π(53 min left), (H)elp, More? Writeln(AnsiFile);π NormVideo;π Close(AnsiFile);πend.π 6 05-28-9313:33ALL SWAG SUPPORT TEAM ANSI Ouput w/ INT29 IMPORT 6 {πROBERT ROTHENBURGππFor those interested in using ANSI in Turbo Pascal (at least Dos v2-5π...I don't know if Dos 6 Uses this routine--Interrupt $29--or not)πhere's a tip: The "undocumented" Fast PutChar interrupt is used byπANSI.SYS, and thus anything you send to that interrupt will beπANSI-interpreted (provided ANSI.SYS is loaded :).ππUse this routine to output a Character to ANSI:π(you'll have to modify it to output Strings, of course).π}ππUsesπ Dos;ππProcedure FastPutChar(C : Char);π{ Outputs only to "display", not stdout! Uses Dos v2-5. }πVarπ Reg : Registers;πbeginπ Reg.AL := Ord(C);π Intr($29, Reg)πend;ππ 7 05-28-9313:33ALL SWAG SUPPORT TEAM CRT Clone with ANSI IMPORT 62 {π Well here it is again, its a little rough and some of the Crt.tpu Functionsπare left out. This Unit will generate Ansi TextColor and TextBackGrounds.πBecuase of the Ansi screen Writes you can send the Program to the com portπjust by using CTTY or GateWay in a bat File before you start your Program.π}ππUnit Crtclone;ππInterfaceππConstπ{ Foreground and background color Constants }ππ Black = 0;π Blue = 1;π Green = 2;π Cyan = 3;π Red = 4;π Magenta = 5;π Brown = 6;π LightGray = 7;ππ{ Foreground color Constants }ππ DarkGray = 8;π LightBlue = 9;π LightGreen = 10;π LightCyan = 11;π LightRed = 12;π LightMagenta = 13;π Yellow = 14;π White = 15;ππ{ Add-in For blinking }ππ Blink = 128;ππVarππ{ Interface Variables }ππ CheckBreak: Boolean; { Enable Ctrl-Break }π CheckEOF: Boolean; { Enable Ctrl-Z }π Procedure TextColor(Color: Byte);π Procedure TextBackground(Color: Byte);π Function KeyPressed : Boolean;π Function GetKey : Char;π Function ReadKey : Char;π Function WhereX : Byte;π Function WhereY : Byte;π Procedure NormVideo;π Procedure ClrEol;π Procedure ClrScr;π Procedure GotoXY(X, Y : Byte);πππ Implementationππ Function KeyPressed : Boolean; { Replacement For Crt.KeyPressed }π { ;Detects whether a key is pressed}π { ;Does nothing With the key}π { ;Returns True if key is pressed}π { ;Otherwise, False}π { ;Key remains in kbd buffer}π Var IsThere : Byte;π beginπ Inline(π $B4/$0B/ { MOV AH,+$0B ;Get input status}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>ISTHERE); { MOV >IsThere[BP],AL ;Move into Variable}π if IsThere = $FF then KeyPressed := True else KeyPressed := False;π end;ππ Procedure ClrEol; { ANSI replacement For Crt.ClrEol }π beginπ Write(#27'[K');π end;ππ Procedure ClrScr; { ANSI replacement For Crt.ClrScr }π beginπ Write(#27'[2J');π end;ππ Function GetKey : Char; { Additional Function. Not in Crt Unit }π Var CH : Char;π beginπ Inline(π {; Function GetKey : Char}π {; Clears the keyboard buffer then waits Until}π {; a key is struck. if the key is a special, e.g.}π {; Function key, goes back and reads the next}π {; Byte in the keyboard buffer. Thus does}π {; nothing special With Function keys.}π $B4/$0C { MOV AH,$0C ;Set up to clear buffer}π /$B0/$08 { MOV AL,8 ;then to get a Char}π /$CD/$21 {SPCL: INT $21 ;Call Dos}π /$3C/$00 { CMP AL,0 ;if it's a 0 Byte}π /$75/$04 { JNZ CHRDY ;is spec., get second Byte}π /$B4/$08 { MOV AH,8 ;else set up For another}π /$EB/$F6 { JMP SHORT SPCL ;and get it}π /$88/$46/>CH {CHRDY: MOV >CH[BP],AL ;else put into Function return}π );π if CheckBreak and (Ch = #3) thenπ begin {if CheckBreak is True and it's a ^C}π Inline( {then execute Ctrl_Brk}π $CD/$23);π end;π GetKey := Ch;π end; {Inline Function GetKey}πππ Function ReadKey : Char; { Replacement For Crt.ReadKey }π Var chrout : Char;π beginπ { ;Just like ReadKey in Crt Unit}π Inline(π $B4/$07/ { MOV AH,$07 ;Char input w/o echo}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>CHROUT); { MOV >chrout[bp],AL ;Put into Variable}π if CheckBreak and (chrout = #3) then {if it's a ^C and CheckBreak True}π begin {then execute Ctrl_Brk}π Inline(π $CD/$23); { INT $23}π end;π ReadKey := chrout; {else return Character}π end;ππ Function WhereX : Byte; { ANSI replacement For Crt.WhereX }π Var { Cursor position report. This is column or }π ch : Char; { X axis report.}π st : String;π st1 : String[2];π x : Byte;π i : Integer;ππ beginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use X here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,6,2); { Pick off subString having number in ASCII}π Val(St1,x,i); { Make it numeric }π WhereX := x; { Return the number }π end;ππ Function WhereY : Byte; { ANSI replacement For Crt.WhereY }π Var { Cursor position report. This is row or }π ch : Char; { Y axis report.}π st : String;π st1 : String[2];π y : Byte;π i : Integer;ππ beginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use Y here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,3,2); { Pick off subString having number in ASCII}π Val(St1,y,i); { Make it numeric }π WhereY := y; { Return the number }π end;πππ Procedure GotoXY(x : Byte ; y : Byte); { ANSI replacement For Crt.GoToXY}π beginπ if (x < 1) or (y < 1) then Exit;π if (x > 80) or (y > 25) then Exit;π Write(#27'[',y,';',x,'H');π end;ππ Procedure TextBackGround(Color:Byte);π beginπ Case color ofπ 0: begin Write(#27#91#52#48#109); end;π 1: begin Write(#27#91#52#52#109); end;π 2: begin Write(#27#91#52#50#109); end;π 3: begin Write(#27#91#52#54#109); end;π 4: begin Write(#27#91#52#49#109); end;π 5: begin Write(#27#91#52#53#109); end;π 6: begin Write(#27#91#52#51#109); end;π 6: begin Write(#27#91#52#55#109); end;π end;π end;ππ Procedure TextColor(Color:Byte);π beginπ Case color ofπ 0: begin Write(#27#91#51#48#109); end;π 1: begin Write(#27#91#51#52#109); end;π 2: begin Write(#27#91#51#50#109); end;π 3: begin Write(#27#91#51#54#109); end;π 4: begin Write(#27#91#51#49#109); end;π 5: begin Write(#27#91#51#53#109); end;π 6: begin Write(#27#91#51#51#109); end;π 7: begin Write(#27#91#51#55#109); end;π 8: begin Write(#27#91#49#59#51#48#109); end;π 9: begin Write(#27#91#49#59#51#52#109); end;π 10: begin Write(#27#91#49#59#51#50#109); end;π 11: begin Write(#27#91#49#59#51#54#109); end;π 12: begin Write(#27#91#49#59#51#49#109); end;π 13: begin Write(#27#91#49#59#51#53#109); end;π 14: begin Write(#27#91#49#59#51#51#109); end;π 15: begin Write(#27#91#49#59#51#55#109); end;π 128: begin Write(#27#91#53#109); end;π end;π end;ππ Procedure NormVideo;π beginπ Write(#27#91#48#109);π end;ππend.π 8 05-28-9313:33ALL SWAG SUPPORT TEAM Detect ANSI.SYS InstalledIMPORT 12 {πThe following Functions provide a way to determine if the machineπthe your application is running on has ANSI installed.ππif your Program is written using the Crt Unit the Function may returnπthe result as False even if ANSI is present, unless you successfullyπuse a 'work around' method to ensure all Writes go through Dos.ππI find it's easier just to not use Crt if my Program is working WithπANSI - since there is not much that you use the Crt Unit For that can'tπbe done in some other way.ππThe Dos-based alternatives to ReadKey and KeyPressed are included sinceπthey are needed For the AnsiDetect Function.π}ππUsesπ Dos;ππFunction KeyPressed : Boolean;π { Detects whether a key is pressed. Key remains in kbd buffer}πVarπ r: Registers;πbeginπ r.AH := $0B;π MsDos(r);π KeyPressed := (r.AL = $FF)πend;ππFunction ReadKey : Char;πVarπ r: Registers;πbeginπ r.AH := $08;π MsDos(r);π ReadKey := Chr(r.AL)πend;ππFunction AnsiDetected: Boolean;π{ Detects whether ANSI is installed }πVarπ dummy: Char;πbeginπ Write(#27'[6n'); { Ask For cursor position report via }π if not KeyPressed { the ANSI driver. }π thenπ AnsiDetected := Falseπ elseπ beginπ AnsiDetected := True;π { empty the keyboard buffer }π Repeat Dummy := ReadKey Until not KeyPressedπ endπend;ππbeginπend.ππ 9 05-28-9313:33ALL SWAG SUPPORT TEAM THEDRAW UNCRUNCH Image IMPORT 32 {Reading in a thedraw image :)π}πProcedure UNCRUNCH (Var Addr1,Addr2; BlkLen:Integer);ππbeginπ Inline (π $1E/ { PUSH DS ;Save data segment.}π $C5/$B6/ADDR1/ { LDS SI,[BP+Addr1] ;Source Address}π $C4/$BE/ADDR2/ { LES DI,[BP+Addr2] ;Destination Addr}π $8B/$8E/BLKLEN/ { MOV CX,[BP+BlkLen] ;Length of block}π $E3/$5B/ { JCXZ Done}π $8B/$D7/ { MOV DX,DI ;Save X coordinate Forπlater.}π $33/$C0/ { xor AX,AX ;Set Current attributes.}π $FC/ { CLD}π $AC/ {LOOPA: LODSB ;Get next Character.}π $3C/$20/ { CMP AL,32 ;if a control Character,πjump.}π $72/$05/ { JC ForeGround}π $AB/ { StoSW ;Save letter on screen.}π $E2/$F8/ {Next: LOOP LOOPA}π $EB/$4C/ { JMP Short Done}π {ForeGround:}π $3C/$10/ { CMP AL,16 ;if less than 16, thenπchange the}π $73/$07/ { JNC BackGround ;Foreground color.πotherwise jump.}π $80/$E4/$F0/ { and AH,0F0H ;Strip off oldπForeground.}π $0A/$E0/ { or AH,AL}π $EB/$F1/ { JMP Next}π {BackGround:}π $3C/$18/ { CMP AL,24 ;if less than 24, thenπchange the}π $74/$13/ { JZ NextLine ;background color. ifπexactly 24,}π $73/$19/ { JNC FlashBittoggle ;then jump down to nextπline.}π $2C/$10/ { SUB AL,16 ;otherwise jump toπmultiple output}π $02/$C0/ { ADD AL,AL ;routines.}π $02/$C0/ { ADD AL,AL}π $02/$C0/ { ADD AL,AL}π $02/$C0/ { ADD AL,AL}π $80/$E4/$8F/ { and AH,8FH ;Strip off oldπbackground.}π $0A/$E0/ { or AH,AL}π $EB/$DA/ { JMP Next}π {NextLine:}π $81/$C2/$A0/$00/ { ADD DX,160 ;if equal to 24,}π $8B/$FA/ { MOV DI,DX ;then jump down to}π $EB/$D2/ { JMP Next ;the next line.}π {FlashBittoggle:}π $3C/$1B/ { CMP AL,27 ;Does user want to toggleπthe blink}π $72/$07/ { JC MultiOutput ;attribute?}π $75/$CC/ { JNZ Next}π $80/$F4/$80/ { xor AH,128 ;Done.}π $EB/$C7/ { JMP Next}π {MultiOutput:}π $3C/$19/ { CMP AL,25 ;Set Z flag ifπmulti-space output.}π $8B/$D9/ { MOV BX,CX ;Save main counter.}π $AC/ { LODSB ;Get count of number ofπtimes}π $8A/$C8/ { MOV CL,AL ;to display Character.}π $B0/$20/ { MOV AL,32}π $74/$02/ { JZ StartOutput ;Jump here if displayingπspaces.}π $AC/ { LODSB ;otherwise get Characterπto use.}π $4B/ { DEC BX ;Adjust main counter.}π {StartOutput:}π $32/$ED/ { xor CH,CH}π $41/ { inC CX}π $F3/$AB/ { REP StoSW}π $8B/$CB/ { MOV CX,BX}π $49/ { DEC CX ;Adjust main counter.}π $E0/$AA/ { LOOPNZ LOOPA ;Loop if anything else toπdo...}π $1F); {Done: POP DS ;Restore data segment.}πend; {UNCRUNCH}π 10 05-28-9313:33ALL SWAG SUPPORT TEAM Display THEDRAW Images IMPORT 8 {π> if you save as Pascal, and follow the instructions in the manual Forπ> TheDraw everything will work fine. It is also much more efficient thenπ> using normal ANSI-Files, since TheDraw-Pascal Files can be Compressed...π}πVarπ VideoSeg : Word;ππProcedure VisTheDrawImage(x, y, Depth, Width: Byte; Var Picture);πVarπ c : Byte;π scrpos : Word;πbeginπ Dec(y);π Dec(x);π ScrPos := y * (ScrCol Shl 1) + x * 2;π For c := 0 to Depth-1 Doπ Move(Mem[Seg(Picture) : ofs(Picture) + c * (Width Shl 1)],π Mem[VideoSeg : c * (ScrCol Shl 1) + ScrPos], Width Shl 1);πend;ππ{πif you picture is not crunched you can use this routine to show them WithπVideoSeg has to be $B000 or $B800, then use the Vars from the generatedπpicture and insert when you call that procedure.π} 11 05-28-9313:33ALL SWAG SUPPORT TEAM How To Use THEDRAW IMPORT 6 > Also does anyone know how to import TheDraw Files into a prg and getπ> them to show properly. Thanks.ππSave the Files into Bin Format, then run BinOBJ on them. When you select aπpublic name, remember that this will be the Procedure's name.ππAfter that Write:ππProcedure <public name>; External; {$L <objname>}ππWalkthrough example:πππSaved File: Welcom.BinππBinOBJ WELCOME WELCOME WELCOMESCREENππIn pascal:ππProcedure WelcomeScreen; External; {$L WELCOME.OBJ}ππIn order to display, dump the Procedure to b800:0 -ππMove(@WelcomeScreen,Mem[$B800:0],4000];ππ4000 is the size For 80x25. The size is x*y*2.ππ 12 05-28-9313:33ALL SWAG SUPPORT TEAM How To Use THEDRAW #2 IMPORT 19 Well, everyone is asking how to integrate a picture from The Draw into yourπPascal Program, so here is how to do it.ππFirst start up The Draw, and either Draw, or load your picture(prettyπsimple).ππthen select Save.πWhen asked For a save Format, select (ObJect).πFor Save Mode, select (Normal).πFor Memory Model, select (Turbo Pascal v4+).πFor Reference identifier to use, Type in the name that you wish to have theπpicture Procedure named, this will be explained later.πthen, For the Filename, of course enter the Filename you wish to save itπunder.ππNext, is the method to place The .OBJ image into your Program.πSomewhere up in the declairations area (after the Var statements, andπbeFore your begin) place the following:ππ{$L C:\PATH\PICTURE.OBJ}πProcedure ProcName; external; {Change ProcName to the Reference Identifierπ That you used when saving the picture}ππthen, to call that picture, there is 1 of 2 ways. First of all, you canπmake another Procedure immediatly after this one that goes as such:ππProcedure DrawANSIScreen;πbeginπ Move(Pointer(@ProcName)^,prt($B800,0)^,4000);πend;ππthen all you have to do is call the Procedure DrawANSIScreen to draw yourπpicture. or you can copy that line beginning With Move into your sourceπcode directly. Make sure to again replace the ProcName With your specifiedπReferecne Identifier. Make sure to give each picture a differentπIdentifier, I do not know what the outcome would be if you used the sameπone. Probally wouldn't even Compile. Also, I have not tried this WithπAnimation. Considering that this Writes directly to screen, it proballyπwon't work, or will be too fast For the human eye to follow. On top ofπthis, I migh point out that since this IS a direct video access, the cursorπWILL not move For it's last position when the screen is printed, so you canπfill the Complete screen, and it will not scroll.ππHope that this has been helpful. It's very easy, and I pulled it directπfrom The Draw docs. This is supposed to work With Pascal 6.0 and up only.πto work With earlier Pascal versions, please read the docs. They entail theπprocess Completely (but not very understandibly <G>).ππ 13 05-28-9313:33ALL SWAG SUPPORT TEAM Displaying THEDRAW ImagesIMPORT 7 {▐ Oh, about the thedraw screens, here'sπ▐ a bit of code in which you can load up a File saved as O)bject, P)ascal.π▐ Oh this is saved as Uncrunched not Crunched.π▐π▐ {$L,TESTFile.OBJ} {This is the File you saved in thedraw as a Object}π {It is linked directly into the code at Compile time}ππ Procedure ImageData; external; {The imagedata Procedure you can}π {define the name of this Procedure}π {when you save the File in TheDraw}π beginπ Move (Pointer(@ImageData)^,ptr($B800,0)^,5000);π Readln;π end.ππ{By using the Move instruction, the placement of the imageπis restricted to full screens or essentially 80 Character lines.π}π 14 05-28-9313:33ALL SWAG SUPPORT TEAM Display THEDRAW BIN File IMPORT 17 {πHere are the relevant pieces from a Program I wrote to convert TheDrawπ.Bin Files to .ANS Files. Why? TheDraw's .ANSI Files are incrediblyπwasteful! The display speed of the menus of the BBS I wrote this Forπnow redraw at 300% the speed they used to!ππif you (or anyone) wants the full Program, give me a yell.π}ππProgram Bin2Ansi;ππUsesπ Crt,Dos;ππVarπ Filenum :Byte; {Points to the command line parameter now being looked at}π fName :String; {File from cmd line - possibly With wildcards}π Filesdone :Word;ππ Procedure ParseFile (Var cmdFName:String);ππ Varπ Details:SearchRec;π fDir, fName, fExt:String;π Dummy:String;π {The parts of the name of the source .Bin File}ππ beginπ {Default extension}π if pos ('.',cmdFName) = 0 then cmdFName := cmdFName + '.Bin';π FSplit(cmdFName, fDir, dummy, dummy); {Get the directory name}π {Check to see if we have any matches For this Filespec}π FindFirst (cmdFName,AnyFile,Details);π if DosError <> 0 then beginπ Writeln ('Filespec: ',cmdfname);π error (7,warning);π end else beginπ While DosError = 0 do beginπ FSplit(fdir+details.name, dummy, fName, fExt); {Get the directory name}π assign (BinFile,fdir+details.name);π Write ('Opening File: ',details.name,#13);π {$i-}π reset (BinFile);π {$i+}π end else beginπ Writeln (details.name,' --> ',fname,'.ANS ');π process (BinFile,fdir+fname+'.ANS');π close (BinFile);π end;π FindNext (Details);π end;π end;π end;ππbeginπ directvideo := False;π Filesdone := 0;π header;π if paramcount < 1 then error (1,fatal);π FileNum := 0;π Repeatπ fname := paramstr (Filenum + 1);π ParseFile (fname);π inc (FileNum);π Until paramstr (FileNum + 1) = '';π Writeln; Write (' ■ Done, With ',Filesdone,' File');π if Filesdone <> 1 then Write ('s');π Writeln (' processed.');πend.π
